Assignment1: TOD Study in Dallas, Texas
Emma Sun
9/18/2020
I. Introduction & Motivation
II. Setup: Set parameters and load libraries
1. Load Libraries
knitr::opts_chunk$set(echo = TRUE)
options(scipen=999)
library(tidyverse)
library(tidycensus)
library(sf)
library(gridExtra)
library(grid)
library(knitr)
library(kableExtra)
library(rmarkdown)2. Load Styling Options
mapTheme <- function(base_size = 12) {
theme(
text = element_text( color = "black"),
plot.title = element_text(size = 16,colour = "black"),
plot.subtitle=element_text(face="italic"),
plot.caption=element_text(hjust=0),
axis.ticks = element_blank(),
panel.background = element_blank(),axis.title = element_blank(),
axis.text = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
strip.text.x = element_text(size = 14))
}
plotTheme <- function(base_size = 12) {
theme(
text = element_text( color = "black"),
plot.title = element_text(size = 16,colour = "black"),
plot.subtitle = element_text(face="italic"),
plot.caption = element_text(hjust=0),
axis.ticks = element_blank(),
panel.background = element_blank(),
panel.grid.major = element_line("grey80", size = 0.1),
panel.grid.minor = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
strip.background = element_rect(fill = "grey80", color = "white"),
strip.text = element_text(size=12),
axis.title = element_text(size=12),
axis.text = element_text(size=10),
plot.background = element_blank(),
legend.background = element_blank(),
legend.title = element_text(colour = "black", face = "italic"),
legend.text = element_text(colour = "black", face = "italic"),
strip.text.x = element_text(size = 14)
)
}3. Functions Preparation
qBr <- function(df, variable, rnd) {
if (missing(rnd)) {
as.character(quantile(round(df[[variable]],0),
c(.01,.2,.4,.6,.8), na.rm=T))
} else if (rnd == FALSE | rnd == F) {
as.character(formatC(quantile(df[[variable]]), digits = 3),
c(.01,.2,.4,.6,.8), na.rm=T)
}
}
q5 <- function(variable) {as.factor(ntile(variable, 5))}
multipleRingBuffer <- function(inputPolygon, maxDistance, interval)
{
#create a list of distances that we'll iterate through to create each ring
distances <- seq(0, maxDistance, interval)
#we'll start with the second value in that list - the first is '0'
distancesCounter <- 2
#total number of rings we're going to create
numberOfRings <- floor(maxDistance / interval)
#a counter of number of rings
numberOfRingsCounter <- 1
#initialize an otuput data frame (that is not an sf)
allRings <- data.frame()
#while number of rings counteris less than the specified nubmer of rings
while (numberOfRingsCounter <= numberOfRings)
{
#if we're interested in a negative buffer and this is the first buffer
#(ie. not distance = '0' in the distances list)
if(distances[distancesCounter] < 0 & distancesCounter == 2)
{
#buffer the input by the first distance
buffer1 <- st_buffer(inputPolygon, distances[distancesCounter])
#different that buffer from the input polygon to get the first ring
buffer1_ <- st_difference(inputPolygon, buffer1)
#cast this sf as a polygon geometry type
thisRing <- st_cast(buffer1_, "POLYGON")
#take the last column which is 'geometry'
thisRing <- as.data.frame(thisRing[,ncol(thisRing)])
#add a new field, 'distance' so we know how far the distance is for a give ring
thisRing$distance <- distances[distancesCounter]
}
#otherwise, if this is the second or more ring (and a negative buffer)
else if(distances[distancesCounter] < 0 & distancesCounter > 2)
{
#buffer by a specific distance
buffer1 <- st_buffer(inputPolygon, distances[distancesCounter])
#create the next smallest buffer
buffer2 <- st_buffer(inputPolygon, distances[distancesCounter-1])
#This can then be used to difference out a buffer running from 660 to 1320
#This works because differencing 1320ft by 660ft = a buffer between 660 & 1320.
#bc the area after 660ft in buffer2 = NA.
thisRing <- st_difference(buffer2,buffer1)
#cast as apolygon
thisRing <- st_cast(thisRing, "POLYGON")
#get the last field
thisRing <- as.data.frame(thisRing$geometry)
#create the distance field
thisRing$distance <- distances[distancesCounter]
}
#Otherwise, if its a positive buffer
else
{
#Create a positive buffer
buffer1 <- st_buffer(inputPolygon, distances[distancesCounter])
#create a positive buffer that is one distance smaller. So if its the first buffer
#distance, buffer1_ will = 0.
buffer1_ <- st_buffer(inputPolygon, distances[distancesCounter-1])
#difference the two buffers
thisRing <- st_difference(buffer1,buffer1_)
#cast as a polygon
thisRing <- st_cast(thisRing, "POLYGON")
#geometry column as a data frame
thisRing <- as.data.frame(thisRing[,ncol(thisRing)])
#add teh distance
thisRing$distance <- distances[distancesCounter]
}
#rbind this ring to the rest of the rings
allRings <- rbind(allRings, thisRing)
#iterate the distance counter
distancesCounter <- distancesCounter + 1
#iterate the number of rings counter
numberOfRingsCounter <- numberOfRingsCounter + 1
}
#convert the allRings data frame to an sf data frame
allRings <- st_as_sf(allRings)
}
palette5 <- c("#CCCCFF","#CC99FF","#9966CC","#663399","#330066")4. Load Census API key
knitr::opts_chunk$set(
echo = TRUE,
message = FALSE,
warning = FALSE
)
census_api_key("a7edab3d7c3df571998caab5a3cc12a4ec8d8b61" , overwrite = TRUE)## To install your API key for use in future sessions, run this function with `install = TRUE`.III. Data Manipulation and Visualization
1. Data Wrangling
1.1 Fetch Census Data
# View(load_variables(2009,'acs5',cache = TRUE))
tracts09 <-
get_acs(geography = "tract", variables = c("B25026_001E","B02001_002E","B15001_050E",
"B15001_009E","B19013_001E","B25058_001E",
"B06012_002E"),
year=2009, state= 48, county= 113, geometry=T) %>%
st_transform('EPSG:32138')##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%# Let's "spread" the data into wide form
# each row is tract, each column is variable
tracts09 <-
tracts09 %>%
dplyr::select( -NAME, -moe) %>%
spread(variable, estimate) %>%
dplyr::select(-geometry) %>%
rename(TotalPop = B25026_001,
Whites = B02001_002,
FemaleBachelors = B15001_050,
MaleBachelors = B15001_009,
MedHHInc = B19013_001,
MedRent = B25058_001,
TotalPoverty = B06012_002)
# st_drop_geometry drops the geometry of its argument, and reclasses it accordingly
st_drop_geometry(tracts09)[1:3,]## # A tibble: 3 x 8
## GEOID Whites TotalPoverty MaleBachelors FemaleBachelors MedHHInc TotalPop
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4811… 3621 311 11 54 77036 4269
## 2 4811… 3146 140 11 10 92212 3435
## 3 4811… 3529 163 0 41 80195 3880
## # … with 1 more variable: MedRent <dbl># Let's create new rate variables using mutate
tracts09 <-
tracts09 %>%
mutate(pctWhite = ifelse(TotalPop > 0, Whites / TotalPop, 0),
pctBachelors = ifelse(TotalPop > 0, ((FemaleBachelors + MaleBachelors) / TotalPop), 0),
pctPoverty = ifelse(TotalPop > 0, TotalPoverty / TotalPop, 0),
year = "2009") %>%
dplyr::select(-Whites,-FemaleBachelors,-MaleBachelors,-TotalPoverty)
# Tracts 2009 is now complete. Let's grab 2017 tracts and do a congruent
# set of operations
# ---- 2017 Census Data -----
# Notice that we are getting "wide" data here in the first place
# This saves us the trouble of using "spread"
tracts17 <-
get_acs(geography = "tract", variables = c("B25026_001E","B02001_002E","B15001_050E",
"B15001_009E","B19013_001E","B25058_001E",
"B06012_002E"),
year=2017, state= 48, county= 113, geometry=T, output="wide") %>%
st_transform('EPSG:32138') %>%
rename(TotalPop = B25026_001E,
Whites = B02001_002E,
FemaleBachelors = B15001_050E,
MaleBachelors = B15001_009E,
MedHHInc = B19013_001E,
MedRent = B25058_001E,
TotalPoverty = B06012_002E) %>%
dplyr::select(-NAME, -starts_with("B")) %>% #-starts_with("B") awesome!
mutate(pctWhite = ifelse(TotalPop > 0, Whites / TotalPop,0),
pctBachelors = ifelse(TotalPop > 0, ((FemaleBachelors + MaleBachelors) / TotalPop),0),
pctPoverty = ifelse(TotalPop > 0, TotalPoverty / TotalPop, 0),
year = "2017") %>%
dplyr::select(-Whites, -FemaleBachelors, -MaleBachelors, -TotalPoverty) ##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%# --- Combining 09 and 17 data ----
allTracts <- rbind(tracts09,tracts17)1.2 Load Transit Data
ggplot() +
geom_sf(data= Dallas) +
geom_sf(data=D_Stops,
aes(color = 'orange'),
show.legend = "point", size= 2) +
scale_colour_manual(values = c("orange"),
labels = 'Stations',
name = ' ') +
labs(title="Dallas Transit Stops",
subtitle=" ",
caption="Figure 1.1") +
plotTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold"))
1.3 Create Buffers
D_Buffers <-
rbind(
st_buffer(D_Stops, 2640) %>%
mutate(Legend = "Buffer") %>%
dplyr::select(Legend),
st_union(st_buffer(D_Stops, 2640)) %>%
st_sf() %>%
mutate(Legend = "Unioned Buffer"))
buffer <- filter(D_Buffers, Legend=="Unioned Buffer")
selectCentroids <-
st_centroid(tracts09)[buffer,] %>%
st_drop_geometry() %>%
left_join(dplyr::select(tracts09, GEOID)) %>%
st_sf() %>%
dplyr::select(TotalPop) %>%
mutate(Selection_Type = "Select by Centroids")
head(selectCentroids,5)## Simple feature collection with 5 features and 2 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: 751852.2 ymin: 2126799 xmax: 763584.6 ymax: 2133648
## projected CRS: NAD83 / Texas North Central
## # A tibble: 5 x 3
## TotalPop geometry Selection_Type
## <dbl> <MULTIPOLYGON [m]> <chr>
## 1 3435 (((763584.6 2131097, 763548.7 2131008, 763555.5 213… Select by Centr…
## 2 3880 (((761950 2131425, 762770.1 2131660, 762760.9 21310… Select by Centr…
## 3 4403 (((761132.5 2131035, 761347.6 2131049, 761950 21314… Select by Centr…
## 4 3232 (((756820.6 2128414, 756877.4 2128489, 756961.2 212… Select by Centr…
## 5 8222 (((753714.9 2133577, 753892 2133624, 753919.7 21336… Select by Centr…2. TOD vs. Non-TOD: Four Variables
2.1 Census Data in Group by TODs
allTracts.group <-
rbind(
st_centroid(allTracts)[buffer,] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "TOD"),
st_centroid(allTracts)[buffer, op = st_disjoint] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "Non-TOD")) %>%
mutate(MedRent.inf = ifelse(year == "2009", MedRent * 1.14, MedRent)) # inflation2.2 TOD and Non-TOD between 2009 and 2017
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = TOD)) +
labs(title = "Time/Space Groups",
subtitle = '',
caption = 'Figure 2.1') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
2.3 Median Rent Comparison between 2009 and 2017
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = q5(MedRent.inf))) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "MedRent.inf"),
name = "Rent\n(Quintile Breaks)") +
labs(title = "Median Rent (w/inflation) 2009-2017",
subtitle = "Real dollars \n",
caption = 'Figure 2.2.1') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = q5(MedRent.inf))) +
geom_sf(data = buffer, fill = "transparent", color = "orange" ) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "MedRent.inf"),
name = "Rent\n(Quintile Breaks)") +
labs(title = "Median Rent (w/inflation) 2009-2017 ",
subtitle = "Real dollars; The orange border denotes areas close to transit stations \n",
caption = 'Figure 2.2.2') +
facet_wrap(~year) +
mapTheme() +
theme(plot.title = element_text(size=15)) +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
2.4 Percentage of White Group between 2009 and 2017
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09)) +
geom_sf(aes(fill = q5(pctWhite))) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctWhite"),
name = "Percentage of White Group\n(Quintile Breaks)") +
labs(title = "Percentage of White Group 2009-2017",
subtitle = '',
caption = 'Figure 2.3.1') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09)) +
geom_sf(aes(fill = q5(pctWhite))) +
geom_sf(data = buffer, fill = "transparent", color = "red") +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctWhite"),
name = "Percentage of White Group\n(Quintile Breaks)") +
labs(title = "Percentage of White Group 2009-2017" ,
subtitle = '',
caption = 'Figure 2.3.2') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
2.5 Bachelor Degree Comparison between 2009 and 2017
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = q5(pctBachelors))) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctBachelors"),
name = "Percentage of Bachelar Degree\n(Quintile Breaks)") +
labs(title = "Bachelor Degree Comparison between 2009-2017",
subtitle = '',
caption = 'Figure 2.4.1') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = q5(pctBachelors))) +
geom_sf(data = buffer, fill = "transparent", color = "orange")+
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctBachelors"),
name = "Percentage of Bachelar Degree\n(Quintile Breaks)") +
labs(title = "Bachelor Degree Comparison by TODs (2009-2017)",
subtitle = '',
caption = 'Figure 2.4.2') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
2.6 Median Household Income Comparison between 2009 and 2017
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = q5(MedHHInc))) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "MedHHInc"),
name = "Median Household Income\n(Quintile Breaks)") +
labs(title = "Median Household Income 2009-2017",
subtitle = 'Real dollars \n',
caption = 'Figure 2.5.1') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = q5(MedHHInc))) +
geom_sf(data = buffer, fill = "transparent", color = "orange")+
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "MedHHInc"),
name = "Median Household Income\n(Quintile Breaks)") +
labs(title = "Median Household Income by TODs (2009-2017)",
subtitle = "Real dollars; The orange border denotes areas close to transit stations \n",
caption = 'Figure 2.5.2') +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
3. Grouped Bar Plot
allTracts.Summary <-
st_drop_geometry(allTracts.group) %>%
group_by(year, TOD) %>%
summarize(Rent = mean(MedRent, na.rm = T),
Population = mean(TotalPop, na.rm = T),
`White Proprotion` = mean(pctWhite, na.rm = T),
`Bachelor Degree` = mean(pctBachelors, na.rm = T),
Income = mean(MedHHInc, na.rm = T))
allTracts.Summary %>%
gather(Variable, Value, -year, -TOD) %>%
ggplot(aes(year, Value, fill = TOD)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~Variable, scales = "free", ncol = 3) +
scale_fill_manual(values = c("#debae4", "#800694")) +
labs(title = "Indicator differences across time and space \n",
caption = 'Figure 3.1') +
plotTheme() +
theme(legend.position="bottom") +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
4. Comparison Table
allTracts.Summary %>%
unite(year.TOD, year, TOD, sep = ": ", remove = T) %>%
gather(Variable, Value, -year.TOD) %>%
mutate(Value = round(Value, 2)) %>%
spread(year.TOD, Value) %>%
kable() %>%
kable_styling() %>%
footnote(general_title = "\n",
general = "Table 4.1")| Variable | 2009: Non-TOD | 2009: TOD | 2017: Non-TOD | 2017: TOD |
|---|---|---|---|---|
| Bachelor Degree | 0.01 | 0.01 | 0.01 | 0.02 |
| Income | 57573.74 | 47845.36 | 65220.27 | 59105.64 |
| Population | 5101.41 | 4479.06 | 5186.17 | 4255.57 |
| Rent | 756.44 | 706.39 | 947.34 | 921.06 |
| White Proprotion | 0.61 | 0.61 | 0.61 | 0.66 |
|
|
||||
| Table 4.1 |
5. Graduated Symbol Maps
5.1 Population within 0.5 mile of each transit station
popByStation <-
join_data %>%
group_by(STA_NAME) %>%
summarize(`Total Population` = sum(TotalPop)) %>%
dplyr::select(STA_NAME, `Total Population`) %>%
st_drop_geometry() %>%
left_join(D_Stops)
popByStation_sf <- popByStation %>%
st_sf()
Dallas <- st_read('https://www.dallasopendata.com/api/geospatial/mn9w-m2tp?method=export&format=GeoJSON')## Reading layer `OGRGeoJSON' from data source `https://www.dallasopendata.com/api/geospatial/mn9w-m2tp?method=export&format=GeoJSON' using driver `GeoJSON'
## Simple feature collection with 3 features and 3 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -97.00049 ymin: 32.61333 xmax: -96.46367 ymax: 33.02382
## geographic CRS: WGS 84ggplot() +
geom_sf(data = Dallas, fill = 'lightgrey') +
geom_sf(data = popByStation_sf, aes(size = `Total Population`), color = '#5e9bb2') +
labs(title = "Graduated Symbol Map: \nPopulation within 0.5 Mile of Each Transit Station" ,
subtitle = '',
caption = "Figure 5.1",
fill = 'Total Population') +
plotTheme() +
theme(legend.position="right") +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
5.2 Median rent within 0.5 mile of each transit station
rentByStation <-
join_data %>%
group_by(STA_NAME) %>%
summarize(`Median Rent` = median(na.omit(MedRent))) %>%
dplyr::select(STA_NAME, `Median Rent`) %>%
st_drop_geometry() %>%
left_join(D_Stops)
rentByStation_sf <- rentByStation %>%
st_sf()
ggplot() +
geom_sf(data = Dallas, fill = 'lightgrey') +
geom_sf(data = rentByStation_sf, aes(size = `Median Rent`), color = '#c2a7ef') +
labs(title = "Graduated Symbol Map: \nMedian Rent within 0.5 Mile of Each Transit Station",
subtitle = '',
caption = "Figure 5.2") +
plotTheme() +
theme(legend.position="right") +
theme(plot.title = element_text(color = "darkred", size=15, face="bold"))
6. Rent as a function of distance to subway stations
allTracts.rings <-
st_join(st_centroid(dplyr::select(allTracts, GEOID, year)),
multipleRingBuffer(st_union(D_Stops), 47520, 2640)) %>%
st_drop_geometry() %>%
left_join(dplyr::select(allTracts, GEOID, MedRent, year),
by=c("GEOID"="GEOID", "year"="year")) %>%
st_sf() %>%
mutate(distance = distance / 5280)
allTracts.rings <- na.omit(allTracts.rings)
mean_RENT <- allTracts.rings %>%
group_by(year, distance) %>%
summarize(mean_RENT = mean(MedRent))
ggplot(data = mean_RENT) +
geom_line(aes(x = distance, y = mean_RENT, col = year), size = 2) +
geom_point(aes(x = distance, y = mean_RENT, col = year) , size = 4) +
labs(title = " Rent as a function of distance to subway stations",
subtitle = '',
caption = 'Figure 6.1') +
scale_color_manual(values = c('#5f829e','#fab18e'),
name = 'Year') +
theme(legend.position = "right") +
xlab("Distance to Stations, Miles") +
ylab("Average Rents") +
theme_classic() +
theme(plot.title = element_text(color = "darkred", size=15, face="bold")) 
7. Crime Rate, Transit Access and Rents
